home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / lisp / wcl-21.lha / wcl-2.1 / src / compiler / cross / cross-functions.lisp < prev    next >
Lisp/Scheme  |  1992-09-10  |  3KB  |  107 lines
  1. ;;; (C) Copyright 1990-1992 by Wade L. Hennessey. All rights reserved.
  2.  
  3. (in-package "W")
  4.  
  5. (defvar *delay-structure-defs?* nil)
  6. (defvar *delayed-structure-defs?* nil)
  7. (defvar *unbound* "UNBOUND")
  8. (defvar *input-stream-line-numbers?* nil)
  9. (defvar *lisp-package* (find-package "W"))
  10. (defvar *host-lisp-package* (find-package "LISP"))
  11. (defvar *keyword-package* (find-package "KEYWORD"))
  12. (defvar *cl-version* 0)
  13.  
  14. (defconstant special-symbol-flag 0)
  15. (defconstant constant-symbol-flag 1)
  16. (defconstant macro-symbol-flag 2)
  17.  
  18. (defmacro defun-inline (name &rest stuff)
  19.   `(defun ,name ,@stuff))
  20.  
  21. (load "../cl/decls/defstruct.lisp")
  22. (load "../cl/functions/defstruct.lisp")
  23. (load "../cl/decls/destructuring-bind.lisp")
  24. (load "../cl/decls/constants.lisp")
  25. (load "../cl/decls/cl-types.lisp")
  26. (load "../cl/functions/cross-functions.lisp")
  27.  
  28. (defun proclaimed-special? (name)
  29.   (let ((info (get-variable-info name)))
  30.     (and info (variable-info-kind info))))
  31.  
  32. (defun constant-var? (name)
  33.   (let ((info (get-variable-info name)))
  34.     (and info (eq (variable-info-kind info) :constant))))
  35.  
  36. (defun proclaim-special-variable (name)
  37.   (setf (variable-info-kind (get-or-create-variable-info name)) :special))
  38.  
  39. (defun proclaim-constant-variable (name constant-expr)
  40.   (let ((info (get-or-create-variable-info name)))
  41.     (setf (variable-info-kind info) :constant)
  42.     (setf (variable-info-constant-expr info) constant-expr)))
  43.  
  44. (defun constant-expr (variable)
  45.   (variable-info-constant-expr (get-variable-info variable)))
  46.  
  47. (defun complete-delayed-defstructs () nil)
  48.  
  49. (defparameter *package-abbrev-alist*
  50.   (list
  51.    (cons (find-package "LISP") #("s_lsp_" "p_lsp_" "m_lsp_"))
  52.    (cons (find-package "W") #("s_lsp_" "p_lsp_" "m_lsp_"))
  53.    (cons (find-package "USER") #("s_user_" "p_user_" "m_user_"))
  54.    (cons (find-package "LUCID-COMMON-LISP")  #("s_lsp_" "p_lsp_" "m_lsp_"))
  55.    (cons (find-package "LUCID-RUNTIME-SUPPORT")  #("s_lsp_" "p_lsp_" "m_lsp_"))
  56.    (cons (find-package "KEYWORD") #("s_key_" "p_key_" "m_key_"))))
  57.  
  58. (defparameter *wcl-package* (find-package "W"))
  59.  
  60. (defparameter *lcl-package* (find-package "LUCID-COMMON-LISP"))
  61.  
  62. (defun package-abbrev (package index)
  63.   (let ((entry (assoc package *package-abbrev-alist*)))
  64.     (if (null entry)
  65.     (progn (warn "No package abbrev for ~S, using lisp" package)
  66.            (package-abbrev (find-package "LISP") index))
  67.     (svref (cdr entry) index))))
  68.  
  69. (defun defstruct-package (symbol)
  70.   (declare (ignore symbol))
  71.   *compiler-package*)
  72.  
  73. #+lucid
  74. (def-foreign-function (getpid (:return-type :signed-32bit)
  75.                    (:name "_getpid")
  76.                    (:language :c)))
  77.  
  78.  
  79. (defun getenv (x)
  80.   (environment-variable x))
  81.  
  82. (defun tmpdir ()
  83.   (or (getenv "TMPDIR") "/tmp"))
  84.  
  85. (defun make-line-symbol (x line)
  86.   (declare (ignore line))
  87.   x)      
  88.  
  89. (defun line-symbol-p (s)
  90.   (declare (ignore s))
  91.   nil)
  92.  
  93. (defun line-symbol-line (s)
  94.   (declare (ignore s))
  95.   nil)
  96.  
  97. (defun line-symbol-symbol (s)
  98.   s)
  99.  
  100. (defun source-line (s)
  101.   (declare (ignore s))
  102.   nil)
  103.  
  104. (defun remove-line-symbols (x)
  105.   x)
  106.  
  107.